home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / menuelems.mod (.txt) < prev    next >
Oberon Text  |  1996-03-19  |  9KB  |  234 lines
  1. Syntax10.Scn.Fnt
  2. MODULE MenuElems;   (*NW 4.7.93 / HM 16.9.93 / MH 24.12.93*)
  3.     IMPORT Display, Bitmaps, Viewers, Input, Fonts, Files, Texts, TextFrames, MenuViewers, Oberon;
  4.     CONST
  5.         left = 2; middle = 1; right = 0;  (*mouse keys*)
  6.         YBottom = -223;
  7.     TYPE
  8.         Menu = POINTER TO MenuDesc;
  9.         MenuDesc = RECORD (Texts.ElemDesc)
  10.             text: Texts.Text;
  11.             nofcom, lastcom, mpos, mw, mh, lsp, dsc: INTEGER
  12.         END ;
  13.         EditFrame = POINTER TO EditFrameDesc;
  14.         EditFrameDesc = RECORD (TextFrames.FrameDesc)
  15.             menu: Menu
  16.         END ;
  17.         buf: Texts.Buffer;  (*copy buffer*)
  18.     PROCEDURE WriteTitle(M: Menu; x, y: INTEGER);
  19.         VAR dx, x1, y1, w, h: INTEGER;
  20.             ch: CHAR;
  21.             pat: Display.Pattern;
  22.             R: Texts.Reader;
  23.     BEGIN
  24.         Texts.OpenReader(R, M.text, 0); Texts.Read(R, ch);
  25.         IF R.eot THEN ch := Texts.ElemChar; R.fnt := Fonts.Default END ;
  26.         DEC(y, R.fnt.minY);
  27.         REPEAT
  28.             Display.GetChar(R.fnt.raster, ch, dx, x1, y1, w, h, pat);
  29.             Display.CopyPattern(R.col, pat, x + x1, y + y1, Display.invert);
  30.             INC(x, dx); Texts.Read(R, ch)
  31.         UNTIL R.eot OR (ch <= " ")
  32.     END WriteTitle;
  33.     PROCEDURE DrawMenu(M: Menu; col, x, y, w, h: INTEGER);
  34.         VAR x0, x1, y1, dx: INTEGER; ch: CHAR;
  35.             pat: Display.Pattern;
  36.             R: Texts.Reader;
  37.     BEGIN Display.ReplConst(Display.black, x, y, w, h, 0);
  38.         Display.ReplConst(col, x, y, w, 1, 0);
  39.         Display.ReplConst(col, x+w-1, y, 1, h, 0);
  40.         Display.ReplConst(col, x, y+h-1, w, 1, 0);
  41.         Display.ReplConst(col, x, y, 1, h, 0);
  42.         Texts.OpenReader(R, M.text, M.mpos); Texts.Read(R, ch);
  43.         x0 := x + 4; x := x0; y := y + h - M.lsp - M.dsc - 4;
  44.         WHILE ~R.eot DO
  45.             IF ch = 0DX THEN DEC(y, M.lsp); x := x0
  46.             ELSE Display.GetChar(R.fnt.raster, ch, dx, x1, y1, w, h, pat);
  47.                 Display.CopyPattern(R.col, pat, x+x1, y+y1, 0); INC(x, dx)
  48.             END ;
  49.             Texts.Read(R, ch)
  50.         END
  51.     END DrawMenu;
  52.     PROCEDURE HandleEdit(F: Display.Frame; VAR M: Display.FrameMsg);
  53.         VAR F1: EditFrame;
  54.     BEGIN TextFrames.Handle(F, M);
  55.         WITH F: EditFrame DO
  56.             IF M IS Oberon.CopyMsg THEN
  57.                 NEW(F1);
  58.                 TextFrames.Open(F1, F.text, F.org);
  59.                 F1.handle := F.handle; F1.menu := F.menu; M(Oberon.CopyMsg).F := F1
  60.             END
  61.         END
  62.     END HandleEdit;
  63.     PROCEDURE Edit(M: Menu);
  64.         VAR V: Viewers.Viewer; F: EditFrame;
  65.             T: Texts.Text; x, y: INTEGER;
  66.     BEGIN T := TextFrames.Text("");
  67.         Texts.Save(M.text, 0, M.text.len, buf); Texts.Append(T, buf);
  68.         Oberon.AllocateUserViewer(Oberon.Par.vwr.X, x, y);
  69.         NEW(F); F.menu := M;
  70.         TextFrames.Open(F, T, 0); F.handle := HandleEdit;
  71.         V := MenuViewers.New(TextFrames.NewMenu("Menu", "System.Close  MenuElems.Update "),
  72.                 F, TextFrames.menuH, x, y)
  73.     END Edit;
  74.     PROCEDURE TrackMenu(M: Menu; x, y: INTEGER; VAR cmd: INTEGER);
  75.         VAR mx, my, xbar, wbar, lsp, top, com, old, dy, i: INTEGER; keys: SET; edit, cancel: BOOLEAN;
  76.     BEGIN
  77.         lsp := M.lsp; xbar := x + 4; wbar := M.mw - 8; top := y + M.mh - 4;
  78.         my := y + M.mh - (M.lastcom+1) * lsp;
  79.         Input.Mouse(keys, mx, dy (*i*)); (*dy := my - i;*)
  80.         keys := {middle}; cancel := FALSE; edit := FALSE; old := -1;
  81.         LOOP
  82.             IF (x < mx) & (mx < x + M.mw) & (y + 4 < my) & (my < top) THEN
  83.                 com := (top - my) DIV lsp; Oberon.FadeCursor(Oberon.Mouse)
  84.             ELSE com := -1; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my)
  85.             END ;
  86.             IF com # old THEN
  87.                 IF old >= 0 THEN Display.ReplConst(Display.white, xbar, top-(old+1)*lsp, wbar, lsp, Display.invert) END ;
  88.                 IF com >= 0 THEN Display.ReplConst(Display.white, xbar, top-(com+1)*lsp, wbar, lsp, Display.invert) END ;
  89.                 old := com
  90.             END ;
  91.             IF keys = {} THEN EXIT
  92.             ELSIF keys = {left, middle, right} THEN cancel := TRUE
  93.             ELSIF left IN keys THEN edit := TRUE
  94.             END ;
  95.             Input.Mouse(keys, mx, my); (*my := (my + dy) MOD Display.Height*)
  96.         END ;
  97.         IF cancel THEN com := -1; edit := FALSE END ;
  98.         IF edit THEN Edit(M); com := -1 END ;
  99.         Oberon.FadeCursor(Oberon.Mouse); cmd := com
  100.     END TrackMenu;
  101.     PROCEDURE Popup(M: Menu; col, x, y: INTEGER);
  102.         VAR i, j, cmd, res: INTEGER;
  103.             ch: CHAR; keys: SET;
  104.             cmdStr: ARRAY 32 OF CHAR;
  105.             R: Texts.Reader;
  106.             B: Bitmaps.Bitmap;
  107.             xorg, yorg: INTEGER;
  108.     BEGIN cmd := M.lastcom; xorg := x; yorg := y;
  109.         DEC(x, M.mw DIV 2);
  110.         IF x + M.mw > Display.Width THEN x := Display.Width - M.mw END ;
  111.         DEC(y, (M.nofcom-M.lastcom)*M.lsp - M.lsp DIV 2);
  112.         IF y + M.mh > Display.Height THEN y := Display.Height - M.mh END ;
  113.         Oberon.RemoveMarks(x, y, M.mw, M.mh); Oberon.FadeCursor(Oberon.Mouse);
  114.         (*Display.CopyBlock(x, y, M.mw, M.mh, x, YBottom, 0);  (*save*)*)
  115.         B := Bitmaps.New(M.mw, M.mh); Bitmaps.CopyBlock(Bitmaps.Disp, B, x, y, M.mw, M.mh, 0, 0, 0);
  116.         DrawMenu(M, col, x, y, M.mw, M.mh); TrackMenu(M, x, y, cmd);
  117.         (*Display.CopyBlock(x, YBottom, M.mw, M.mh, x, y, 0);  (*restore*)*)
  118.         Bitmaps.CopyBlock(B, Bitmaps.Disp, 0, 0, M.mw, M.mh, x, y, 0);
  119.         IF cmd >= 0 THEN
  120.             M.lastcom := cmd; j := 0; Texts.OpenReader(R, M.text, M.mpos); Texts.Read(R, ch);
  121.             WHILE j < cmd DO
  122.                 IF ch = 0DX THEN INC(j) END ;
  123.                 Texts.Read(R, ch)
  124.             END ;
  125.             i := 0;
  126.             WHILE (ch > " ") & (i < 31) DO cmdStr[i] := ch; INC(i); Texts.Read(R, ch) END ;
  127.             cmdStr[i] := 0X;
  128.             IF Oberon.Par = NIL THEN NEW(Oberon.Par) END ;
  129.             Oberon.Par.vwr := Viewers.This(xorg, yorg);
  130.             Oberon.Par.frame := Oberon.Par.vwr.dsc; Oberon.Par.text := M.text; Oberon.Par.pos := Texts.Pos(R);
  131.             Oberon.Call(cmdStr, Oberon.Par, FALSE, res)
  132.         END
  133.     END Popup;
  134.     PROCEDURE Load(VAR R: Files.Rider; M: Menu);
  135.         VAR n: LONGINT;
  136.     BEGIN Files.ReadNum(R, n); M.nofcom := SHORT(n); M.lastcom := 0;
  137.         Files.ReadNum(R, n); M.mpos := SHORT(n);
  138.         Files.ReadNum(R, n); M.mw := SHORT(n); Files.ReadNum(R, n); M.mh := SHORT(n);
  139.         Files.ReadNum(R, n); M.lsp := SHORT(n); Files.ReadNum(R, n); M.dsc := SHORT(n);
  140.         M.text := TextFrames.Text("");
  141.         Texts.Load(R, M.text)
  142.     END Load;
  143.     PROCEDURE Store(VAR R: Files.Rider; M: Menu);
  144.     BEGIN Files.WriteNum(R, M.nofcom); Files.WriteNum(R, M.mpos); Files.WriteNum(R, M.mw);
  145.         Files.WriteNum(R, M.mh); Files.WriteNum(R, M.lsp); Files.WriteNum(R, M.dsc);
  146.         Texts.Store(R, M.text)
  147.     END Store;
  148.     PROCEDURE Handle(E: Texts.Elem; VAR msg: Texts.ElemMsg);
  149.         VAR M: Menu;
  150.     BEGIN
  151.         WITH E: Menu DO
  152.             IF msg IS TextFrames.DisplayMsg THEN
  153.                 WITH msg: TextFrames.DisplayMsg DO
  154.                     IF ~msg.prepare THEN WriteTitle(E, msg.X0, msg.Y0) END
  155.                 END
  156.             ELSIF msg IS Texts.CopyMsg THEN
  157.                 WITH msg: Texts.CopyMsg DO
  158.                     NEW(M); Texts.CopyElem(E, M);
  159.                     M.nofcom := E.nofcom; M.lastcom := E.lastcom; M.mpos := E.mpos; M.mw := E.mw;
  160.                     M.mh := E.mh; M.lsp := E.lsp; M.dsc := E.dsc; M.text := TextFrames.Text("");
  161.                     Texts.Save(E.text, 0, E.text.len, buf); Texts.Append(M.text, buf); msg.e := M
  162.                 END
  163.             ELSIF msg IS Texts.IdentifyMsg THEN
  164.                 WITH msg: Texts.IdentifyMsg DO
  165.                     msg.mod := "MenuElems"; msg.proc := "Alloc"
  166.                 END
  167.             ELSIF msg IS Texts.FileMsg THEN
  168.                 WITH msg: Texts.FileMsg DO
  169.                     IF msg.id = Texts.load THEN Load(msg.r, E)
  170.                     ELSIF msg.id = Texts.store THEN Store(msg.r, E)
  171.                     END
  172.                 END
  173.             ELSIF msg IS TextFrames.TrackMsg THEN
  174.                 WITH msg: TextFrames.TrackMsg DO
  175.                     IF msg.keys = {middle} THEN Popup(E, msg.col, msg.X (*msg.X0*), msg.Y0) END
  176.                 END
  177.             END
  178.         END
  179.     END Handle;
  180.     PROCEDURE Alloc*;
  181.         VAR M: Menu;
  182.     BEGIN NEW(M); M.handle := Handle; Texts.new := M
  183.     END Alloc;
  184.     PROCEDURE Update*;
  185.         VAR M: Menu; pos: LONGINT;
  186.             len, dx, x1, y1, w, w1, h, h1: INTEGER; ch: CHAR;
  187.             pat: Display.Pattern;
  188.             F: EditFrame;
  189.             T: Texts.Text;
  190.             R: Texts.Reader;
  191.     BEGIN
  192.         IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN
  193.             F := Oberon.Par.frame.next(EditFrame); M := F.menu; T := F.text;
  194.             Texts.OpenReader(R, T, 0);
  195.             len := 1; w := 0; h := 0; Texts.Read(R, ch);
  196.             WHILE ~R.eot & (ch > " ") DO
  197.                 Display.GetChar(R.fnt.raster, ch, dx, x1, y1, w1, h1, pat); INC(w, dx); INC(len);
  198.                 IF h < R.fnt.height THEN h := R.fnt.height END ;
  199.                 Texts.Read(R, ch)
  200.             END ;
  201.             Texts.Read(R, ch);
  202.             M.W := LONG(w)*Display.Unit; M.H := LONG(h)*Display.Unit; M.mpos := len;
  203.             M.nofcom := 0; M.lastcom := 0; M.mw := 0; M.lsp := 0; M.dsc := 0; w := 0;
  204.             WHILE ~R.eot DO
  205.                 IF ch = 0DX THEN
  206.                     IF M.mw < w THEN M.mw := w END ;
  207.                     w := 0; INC(M.nofcom)
  208.                 ELSE
  209.                     IF M.lsp < R.fnt.height THEN M.lsp := R.fnt.height END ;
  210.                     IF M.dsc > R.fnt.minY THEN M.dsc := R.fnt.minY END ;
  211.                     Display.GetChar(R.fnt.raster, ch, dx, x1, y1, w1, h1, pat); INC(w, dx)
  212.                 END ;
  213.                 Texts.Read(R, ch)
  214.             END ;
  215.             IF w > 0 THEN INC(M.nofcom);
  216.                 IF M.mw < w THEN M.mw := w END
  217.             END ;
  218.             M.mh := M.lsp * M.nofcom + 8; INC(M.mw, 8); M.text := T;
  219.             T := Texts.ElemBase(M); pos := Texts.ElemPos(M); T.notify(T, Texts.replace, pos, pos+1);
  220.             T := Oberon.Par.frame(TextFrames.Frame).text;
  221.             Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch);
  222.             IF ch = "!" THEN Texts.Delete(T, T.len - 1, T.len) END
  223.         END
  224.     END Update;
  225.     PROCEDURE Insert*;
  226.         VAR M: Menu; insert: TextFrames.InsertElemMsg;
  227.     BEGIN  NEW(M);
  228.         M.W := 8*Display.Unit; M.H := M.W; M.lsp := 8; M.mw := 8; M.mh := 8;
  229.         M.text := TextFrames.Text(""); M.handle := Handle;
  230.         insert.e := M; Oberon.FocusViewer.handle(Oberon.FocusViewer, insert)
  231.     END Insert;
  232. BEGIN NEW(buf); Texts.OpenBuf(buf);
  233. END MenuElems.
  234.